(*
  Copyright (c) 2009 Barry Schwartz

  Permission is hereby granted, free of charge, to any person
  obtaining a copy of this software and associated documentation
  files (the "Software"), to deal in the Software without
  restriction, including without limitation the rights to use,
  copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the
  Software is furnished to do so, subject to the following
  conditions:

  The above copyright notice and this permission notice shall be
  included in all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
  OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
  OTHER DEALINGS IN THE SOFTWARE.
*)

open XNum
  
type 'a node =
  | Horiz of num * 'a node * 'a node
  | (* horizontal division *)
  Vert of num * 'a node * 'a node
  | (* vertical division   *)
  Empty
  | Value of 'a

type rect = { min_x : num; min_y : num; max_x : num; max_y : num }

let in_rect r x y =
  (ge_num x r.min_x) &&
    ((le_num x r.max_x) && ((ge_num y r.min_y) && (le_num y r.max_y)))
  
type interval = (num * num)

type 'a map = { nodes : 'a node; bounds : rect }

let empty x0 y0 x1 y1 =
  {
    nodes = Empty;
    bounds =
      {
        min_x = min_num x0 x1;
        min_y = min_num y0 y1;
        max_x = max_num x0 x1;
        max_y = max_num y0 y1;
      };
  }
  
let get_value map x y =
  let rec iter node =
    match node with
    | Empty -> None
    | Value v -> Some v
    | Vert (z, a, b) -> if le_num x z then iter a else iter b
    | Horiz (z, a, b) -> if le_num y z then iter a else iter b
  in if in_rect map.bounds x y then iter map.nodes else None
  
let rec internal_set_rect map x0 y0 x1 y1 contents =
  let rec iter bx0 by0 bx1 by1 x0 y0 x1 y1 node =
    let rec insert_rect bx0 by0 bx1 by1 x0 y0 x1 y1 v =
      if lt_num by0 y0
      then Horiz (y0, v, insert_rect bx0 y0 bx1 by1 x0 y0 x1 y1 v)
      else
        if gt_num by1 y1
        then Horiz (y1, insert_rect bx0 by0 bx1 y1 x0 y0 x1 y1 v, v)
        else
          if lt_num bx0 x0
          then Vert (x0, v, insert_rect x0 by0 bx1 by1 x0 y0 x1 y1 v)
          else
            if gt_num bx1 x1
            then Vert (x1, insert_rect bx0 by0 x1 by1 x0 y0 x1 y1 v, v)
            else contents
    in
      match node with
      | Empty -> insert_rect bx0 by0 bx1 by1 x0 y0 x1 y1 Empty
      | Value v -> insert_rect bx0 by0 bx1 by1 x0 y0 x1 y1 (Value v)
      | Vert (z, a, b) ->
          if le_num z x0
          then Vert (z, a, iter z by0 bx1 by1 x0 y0 x1 y1 b)
          else
            if ge_num z x1
            then Vert (z, iter bx0 by0 z by1 x0 y0 x1 y1 a, b)
            else
              Vert (z, iter bx0 by0 z by1 x0 y0 z y1 a,
                iter z by0 bx1 by1 z y0 x1 y1 b)
      | Horiz (z, a, b) ->
          if le_num z y0
          then Horiz (z, a, iter bx0 z bx1 by1 x0 y0 x1 y1 b)
          else
            if ge_num z y1
            then Horiz (z, iter bx0 by0 bx1 z x0 y0 x1 y1 a, b)
            else
              Horiz (z, iter bx0 by0 bx1 z x0 y0 x1 z a,
                iter bx0 z bx1 by1 x0 z x1 y1 b)
  in
    {
      (map)
      with
      nodes =
        iter map.bounds.min_x map.bounds.min_y map.bounds.max_x
          map.bounds.max_y (max_num x0 map.bounds.min_x)
          (max_num y0 map.bounds.min_y) (min_num x1 map.bounds.max_x)
          (min_num y1 map.bounds.max_y) map.nodes;
    }
  
let set_rect map x0 y0 x1 y1 contents =
  internal_set_rect map x0 y0 x1 y1 (Value contents)
  
let clear_rect map x0 y0 x1 y1 = internal_set_rect map x0 y0 x1 y1 Empty
  
let rec merge_intervals l0 l1 =
  match (l0, l1) with
  | ([], _) -> l1
  | (_, []) -> l0
  | ((a, b) :: xs, (c, d) :: ys) ->
      if le_num b c
      then (a, b) :: (merge_intervals xs l1)
      else
        if le_num d a
        then (c, d) :: (merge_intervals l0 ys)
        else ((min_num a c), (max_num b d)) :: (merge_intervals xs ys)
  
let horiz_strip map y0 y1 =
  let rec iter y0 y1 x0 x1 node =
    match node with
    | Empty -> []
    | Value _ -> [ (x0, x1) ]
    | Vert (z, a, b) -> (iter y0 y1 x0 z a) @ (iter y0 y1 z x1 b)
    | Horiz (z, a, b) ->
        if le_num z y0
        then iter y0 y1 x0 x1 b
        else
          if ge_num z y1
          then iter y0 y1 x0 x1 a
          else merge_intervals (iter y0 z x0 x1 a) (iter z y1 x0 x1 b)
  in
    iter (max_num y0 map.bounds.min_y) (min_num y1 map.bounds.max_y)
      map.bounds.min_x map.bounds.max_x map.nodes
  
let vert_strip map x0 x1 =
  let rec iter x0 x1 y0 y1 node =
    match node with
    | Empty -> []
    | Value _ -> [ (y0, y1) ]
    | Horiz (z, a, b) -> (iter x0 x1 y0 z a) @ (iter x0 x1 z y1 b)
    | Vert (z, a, b) ->
        if le_num z x0
        then iter x0 x1 y0 y1 b
        else
          if ge_num z x1
          then iter x0 x1 y0 y1 a
          else merge_intervals (iter x0 z y0 y1 a) (iter z x1 y0 y1 b)
  in
    iter (max_num x0 map.bounds.min_x) (min_num x1 map.bounds.max_x)
      map.bounds.min_y map.bounds.max_y map.nodes
  
(*
  |find_first_free_interval <p> <min> <max> <strip>| returns the first non-empty interval
  in <strip> satisfying <p>.
*)
let find_first_free_interval p min max strip =
  let rec iter z strip =
    match strip with
    | [] -> if (lt_num z max) && (p z max) then Some ((z, max)) else None
    | (a, b) :: cs ->
        if (lt_num z a) && (p z a) then Some ((z, a)) else iter b cs
  in iter min strip
  
let find_last_free_interval p min max strip =
  let rec iter z strip =
    match strip with
    | [] -> if (lt_num min z) && (p min z) then Some ((min, z)) else None
    | (a, b) :: cs ->
        if (lt_num b z) && (p b z) then Some ((b, z)) else iter a cs
  in iter max (List.rev strip)
  
(*
  The next four routines look for a free rectangle.
  |find_free_top <map> <rect> <height>| returns a pair |(a, b)| where <y> is
  the top most position such that a box of the given height fits on the page.
  |c - y| is the height of the free space.
*)
let find_free_top map min_x min_y max_x max_y height =
  find_last_free_interval
    (fun a b -> le_num (add_num (max_num min_y a) height) (min_num max_y b))
    map.bounds.min_y map.bounds.max_y (vert_strip map min_x max_x)
  
let find_free_bottom map min_x min_y max_x max_y height =
  find_first_free_interval
    (fun a b -> le_num (add_num (max_num min_y a) height) (min_num max_y b))
    map.bounds.min_y map.bounds.max_y (vert_strip map min_x max_x)
  
let find_free_left map min_x min_y max_x max_y width =
  find_first_free_interval
    (fun a b -> le_num (add_num (max_num min_x a) width) (min_num max_x b))
    map.bounds.min_x map.bounds.max_x (vert_strip map min_y max_y)
  
let find_free_right map min_x min_y max_x max_y width =
  find_last_free_interval
    (fun a b -> le_num (add_num (max_num min_x a) width) (min_num max_x b))
    map.bounds.min_x map.bounds.max_x (vert_strip map min_y max_y)
  

